home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / clipper / rlib20.zip / DEMO.PRG < prev    next >
Text File  |  1989-02-18  |  33KB  |  898 lines
  1. * Program.: DEMO.PRG
  2. * Author..: Richard Low
  3. * Date....: October 6, 1988
  4. * Notes...: Program to demonstrate the RLIB functions.
  5. *
  6.  
  7. PARAMETER edit
  8.  
  9. *-- the command line argument "EDIT" will allow mods to memo fields
  10. *-- (I used this flag to build the descriptions )
  11. edit = IF( PCOUNT() = 1, ( UPPER(edit) = 'EDIT' ), .F. )
  12.  
  13. IF .NOT. FILES('demo.dbf', 'demo.dbt')
  14.    ? 'This demo requires the database file DEMO.DBF and its associated memo'
  15.    ? 'file DEMO.DBT which are included in the RLIB package.  Please place'
  16.    ? 'these two files in the current default directory and try again.'
  17.    ? CHR(7)
  18.    RETURN
  19. ENDIF
  20.  
  21. SET PROCEDURE TO demoproc
  22. SAVE SCREEN TO dosscreen
  23. saverow = ROW()
  24. savecol = COL()
  25.  
  26. SET COLOR TO W/N
  27. CLEAR
  28. @ 3,0
  29.  
  30. TEXT
  31.    Welcome to the RLIB demonstration program.  The purpose of this demo is to
  32.    show what RLIB functions can do.  It can also serve as a supplement to the
  33.    documentation by providing examples of RLIB functions in use.
  34.  
  35.    The demo starts by presenting you with a menu of RLIB function categories.
  36.    Each of these categories presents a sub - menu with the available choices.
  37.    The starting menu is a BOXMENU, but you may change the style of menus used
  38.    for the demonstration at any time.   Simply select from the  Menuing Tools
  39.    menu the style of menu you want, and the demo will continue, but under the
  40.    style of menu you have chosen.
  41.  
  42. ENDTEXT
  43.  
  44. @ 1,0,18,79 BOX '┌─┐│┘─└│'
  45.  
  46. *-- first need to initialize all public variables and arrays
  47. DO initialize
  48.  
  49. CENTER( 16, 'Press any key to begin...' )
  50.  
  51. x = INKEY(30)
  52. DO WHILE x = 0
  53.    x = ASC(BOXASK('N/W','The demo will start as soon as you press a key',4))
  54.    x = IF( x = 0, INKEY(10), x )
  55. ENDDO
  56.  
  57. CLEAR
  58.  
  59. IF LASTKEY() = 27
  60.    RETURN
  61. ENDIF
  62.  
  63. SET CURSOR OFF
  64.  
  65. *-- Each active menu routine may control the whole demo.  If the user
  66. *-- selectes a different menu control, the current routine will set
  67. *-- <menustyle> accordingly and exit back to this main loop.  The
  68. *-- Summer '87 BEGIN SEQUENCE facility is used to allow conditional
  69. *-- branching back to this main routine from within the other procs.
  70.  
  71. PUBLIC menustyle, showtime, dummy, single, double
  72.  
  73. menustyle = 2                      && start off with BOXMENU
  74. showtime  = 2                      && seconds to pause while showing syntax
  75. dummy     = ''                     && global DUMMY parameter
  76. single    = '┌─┐│┘─└│'             && used for single line boxes
  77. double    = '╔═╗║╝═╚║'             && used for double line boxes
  78.  
  79.  
  80. *-- open the demo database so quickley retrieve syntax descriptions
  81. USE demo INDEX demo
  82.  
  83.  
  84. *-- each routine will set menustyle to 0 to quit
  85. DO WHILE menustyle > 0
  86.    BEGIN SEQUENCE
  87.       DO CASE
  88.          CASE menustyle = 1
  89.             DO bardemo
  90.  
  91.          CASE menustyle = 2
  92.             DO boxdemo
  93.  
  94.          CASE menustyle = 3
  95.             DO multdemo
  96.  
  97.          CASE menustyle = 4
  98.             DO pulldemo
  99.       ENDCASE
  100.    END
  101. ENDDO
  102.  
  103. RESTORE SCREEN FROM dosscreen
  104. @ saverow,savecol SAY ''
  105. CLOSE DATABASES
  106. SET CURSOR ON
  107. SET COLOR TO
  108. CLEAR ALL
  109. RETURN
  110.  
  111. *-- End of main program.
  112.  
  113.  
  114.  
  115. *----------------------------------------------------------------------------
  116. * Procedure: INITIALIZE
  117. * Notes....: Procedure to initialize demo procedure names into a PUBLIC
  118. *            array to be later referenced via the DIM2() UDF.
  119. *            These demo procedures are called via macro substitution at
  120. *            run time by first retrieving the name of the demo procedure
  121. *            to run from the combination of menu options chosen.  These
  122. *            options pair correspond to the DIM2 location of the procedure
  123. *            name in the <demos> array, which, thanks to the DIM@() UDF,
  124. *            looks and acts like a two dimensional array.
  125. *----------------------------------------------------------------------------
  126. PROCEDURE initialize
  127.  
  128. *-- set color variables and arrays for the demo
  129. PUBLIC democolor, syntaxcolor, background
  130.  
  131. IF ISCOLOR()
  132.    PUBLIC boxcolors[5], barcolors[5], pullcolors[6], multicolors[5]
  133.  
  134.    democolor   = 'W/B,N/W,N,N,N/BG'
  135.    syntaxcolor = 'N/BG,W/B,N,N,N/B'
  136.    background  = 'W/N,N/W,N,N,N/W'
  137.  
  138.    boxcolors[1] = 'W/B'                 && White on Blue display
  139.    boxcolors[2] = 'N/BG'                && Black on Cyan menu bar
  140.    boxcolors[3] = 'BG+/B'               && Bright Cyan on Blue Active Border
  141.    boxcolors[4] = 'BG/B'                && Regular Cyan on Blue In-active Border
  142.    boxcolors[5] = 'GR+/B'               && Yellow on Blue for the selected option
  143.  
  144.    barcolors[1] = 'W/B'                 && White on Blue display
  145.    barcolors[2] = 'N/BG'                && Black on Cyan menu bar
  146.    barcolors[3] = 'BG+/B'               && Bright Cyan on Blue Active Border
  147.    barcolors[4] = 'BG/B'                && Regular Cyan on Blue In-active Border
  148.    barcolors[5] = 'GR+/B'               && Yellow on Blue for the selected option
  149.  
  150.    pullcolors[1] = 'W/B'                 && White on Blue display
  151.    pullcolors[2] = 'N/BG'                && Black on Cyan menu bar
  152.    pullcolors[3] = 'BG+/B'               && Bright Cyan on Blue Active Border
  153.    pullcolors[4] = 'BG/B'                && Regular Cyan on Blue In-active Border
  154.    pullcolors[5] = 'GR+/B'               && Yellow on Blue for the selected option
  155.    pullcolors[6] = 'GR+/B'
  156.  
  157.    multicolors[1] = 'W/B'                 && White on Blue display
  158.    multicolors[2] = 'N/BG'                && Black on Cyan menu bar
  159.    multicolors[3] = 'BG+/B'               && Bright Cyan on Blue Active Border
  160.    multicolors[4] = 'BG/B'                && Regular Cyan on Blue In-active Border
  161.    multicolors[5] = 'GR+/B'               && Yellow on Blue for the selected option
  162. ELSE
  163.    PUBLIC boxcolors, barcolors, pullcolors
  164.  
  165.    democolor   = 'W/N,N/W,N,N,U'
  166.    syntaxcolor = 'N/W,W/N,N,N,U'
  167.    background  = 'W/N,N/W,N,N,U'
  168.    STORE '' TO boxcolors, barcolors, pullcolors
  169.  
  170.    PUBLIC multicolors[5]
  171.    multicolors[1] = 'W/N'                 && White on Black display
  172.    multicolors[2] = 'N/W'                 && Black on White menu bar
  173.    multicolors[3] = ' '
  174.    multicolors[4] = ' '
  175.    multicolors[5] = 'W+/N'               && Bright White for selected option
  176. ENDIF
  177.  
  178. PUBLIC rows, cols                  && this is required by the DIM2() UDF
  179. rows = 6                           && six groups of functions
  180. cols = 7                           && maximum number in each group
  181.  
  182. PUBLIC demos[ rows * cols ]
  183.  
  184. demos[ DIM2(1,1) ] = 'd'
  185. demos[ DIM2(1,2) ] = 'd'
  186. demos[ DIM2(1,3) ] = 'd'
  187. demos[ DIM2(1,4) ] = 'd'
  188.  
  189. demos[ DIM2(2,1) ] = 'd_atinsay'             && Screen functions
  190. demos[ DIM2(2,2) ] = 'd_boxask'
  191. demos[ DIM2(2,3) ] = 'd_bright'
  192. demos[ DIM2(2,4) ] = 'd_center'
  193. demos[ DIM2(2,5) ] = 'd_multimenu'
  194. demos[ DIM2(2,6) ] = 'd_sayinbox'
  195.  
  196. demos[ DIM2(3,1) ] = 'd_filedate'            && File functions
  197. demos[ DIM2(3,2) ] = 'd_files'
  198. demos[ DIM2(3,3) ] = 'd_filetime'
  199. demos[ DIM2(3,4) ] = 'd_parent'
  200. demos[ DIM2(3,5) ] = 'd_pathto'
  201. demos[ DIM2(3,6) ] = 'd_pickfile'
  202.  
  203. demos[ DIM2(4,1) ] = 'd_decrypted'           && Character
  204. demos[ DIM2(4,2) ] = 'd_encrypted'
  205. demos[ DIM2(4,3) ] = 'd_getparm'
  206. demos[ DIM2(4,4) ] = 'd_keyinput'
  207. demos[ DIM2(4,5) ] = 'd_namesplit'
  208. demos[ DIM2(4,6) ] = 'd_rjustify'
  209.  
  210. demos[ DIM2(5,1) ] = 'd_changed'             && Database
  211. demos[ DIM2(5,2) ] = 'd_closearea'
  212. demos[ DIM2(5,3) ] = 'd_forget'
  213. demos[ DIM2(5,4) ] = 'd_markrec'
  214. demos[ DIM2(5,5) ] = 'd_memorize'
  215. demos[ DIM2(5,6) ] = 'd_mreplace'
  216. demos[ DIM2(5,7) ] = 'd_pickrec'
  217.  
  218. demos[ DIM2(6,1) ] = 'd_alphadate'           && Other
  219. demos[ DIM2(6,2) ] = 'd_beep'
  220. demos[ DIM2(6,3) ] = 'd_ntxkeyval'
  221. demos[ DIM2(6,4) ] = 'd_str2date'
  222.  
  223. USE demo
  224. INDEX ON udf_name TO demo
  225. USE
  226. RETURN
  227.  
  228.  
  229. *----------------------------------------------------------------------------
  230. * Function: DIM2
  231. * Notes...: UDF to emulate 2 dimensional arrays.
  232. *----------------------------------------------------------------------------
  233. FUNCTION dim2
  234. PARAMETERS x,y
  235. RETURN (((x - 1) * cols) + y)
  236.  
  237.  
  238.  
  239. *----------------------------------------------------------------------------
  240. * Procedure